home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 001-010 / amok06 / mathlib / r3test.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  181 lines
  1. (**********************************************************************
  2.  
  3.     :Program.       R3Test.mod
  4.     :Contents.     Testmodule for MathLibR2
  5.     :Author.        Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Phone.      711/333679
  8.     :Copyright.  Public Domain
  9.     :Language.      Modula-2
  10.     :Translator. M2Amiga AMSoft
  11.     :Imports.     MathLibR2, IntuiStruct [bne]
  12.     :ModHistory. V1.0 [bne] 16.07.88 (Demo Amok#4)
  13.     
  14. **********************************************************************)
  15.  
  16. MODULE R3Test;
  17.  
  18. FROM MathLibR3    IMPORT Vector3,Matrix3,Add3,Trans3,Mmul3,Scalar,Invert3;
  19. FROM IntuiStruct IMPORT StructScreen,StructWindow;
  20. FROM Graphics    IMPORT RastPortPtr,Draw,Move,SetDrMd,SetAPen,ViewModes,
  21.         ViewModeSet,jam1,WaitTOF,RectFill;
  22. FROM Exec    IMPORT WaitPort;
  23. FROM Intuition    IMPORT ScreenPtr,WindowPtr,ScreenFlags,ScreenFlagSet,
  24.         WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,
  25.                 customScreen,stdScreenHeight,NewScreen,NewWindow,
  26.                 OpenScreen,OpenWindow,CloseScreen,CloseWindow;
  27. FROM Arts    IMPORT Assert;
  28. FROM SYSTEM    IMPORT ADR;
  29. FROM MathTrans    IMPORT Sin,Cos;
  30.  
  31. CONST    Ox=160;
  32.     Oy=122;
  33.         gamma=0.03;
  34.     beta=0.05;
  35.         alpha=-0.1;
  36.         grow=1.003;
  37.  
  38. VAR    Screen:ScreenPtr;
  39.     Window:WindowPtr;
  40.         MyScreen:NewScreen;
  41.         MyWindow:NewWindow;
  42.         RastPort:RastPortPtr;
  43.         Point:ARRAY [1..8] OF Vector3;
  44.         RotX,RotY,RotZ,Matrix:Matrix3;
  45.         Vector:Vector3;
  46.         n,m:INTEGER;
  47.  
  48. PROCEDURE Round(X:Scalar):INTEGER;
  49. BEGIN
  50.   RETURN INTEGER(X+0.5);
  51. END Round;
  52.  
  53. PROCEDURE DeleteCube;
  54. VAR    n:INTEGER;
  55. BEGIN
  56.   SetAPen(RastPort,0);
  57.   RectFill(RastPort,2,10,317,242);
  58. END DeleteCube;
  59.  
  60. PROCEDURE DrawCube;
  61. VAR    n,x,y:INTEGER;
  62.  
  63.   PROCEDURE Perspective(V:Vector3); (* Zentralprojektion *)
  64.   VAR    Scale:Scalar;
  65.   BEGIN
  66.     Scale:=400.0/(V.z+400.0);
  67.     x:=Round(V.x*Scale)+Ox;
  68.     y:=Round(V.y*Scale)+Oy;
  69.   END Perspective;
  70.  
  71. BEGIN
  72.   SetAPen(RastPort,1);
  73.   Perspective(Point[4]);
  74.   Move(RastPort,x,y);
  75.   FOR n:=1 TO 4 DO
  76.     Perspective(Point[n]);
  77.     Draw(RastPort,x,y);
  78.   END;
  79.   Perspective(Point[8]);
  80.   Move(RastPort,x,y);
  81.   FOR n:=5 TO 8 DO
  82.     Perspective(Point[n]);
  83.     Draw(RastPort,x,y);
  84.   END;
  85.   FOR n:=1 TO 4 DO
  86.     Perspective(Point[n]);
  87.     Move(RastPort,x,y);
  88.     Perspective(Point[n+4]);
  89.     Draw(RastPort,x,y);
  90.   END;
  91. END DrawCube;
  92.  
  93. BEGIN
  94.   StructScreen(MyScreen,1,0,1,ViewModeSet{},customScreen,ADR("R³ Test"));
  95.   Screen:=OpenScreen(MyScreen);
  96.   Assert(Screen#NIL,ADR("Screen klemmt"));
  97.   StructWindow(MyWindow,0,12,320,244,-1,-1,IDCMPFlagSet{closeWindow},
  98.       WindowFlagSet{windowClose,simpleRefresh,noCareRefresh,backDrop},
  99.         NIL,Screen,customScreen);
  100.   Window:=OpenWindow(MyWindow);
  101.   Assert(Window#NIL,ADR("Window klemmt"));
  102.   RastPort:=Window^.rPort;
  103.   SetDrMd(RastPort,jam1);
  104.   Point[1].x:=-50.0;    (* Würfel *)
  105.   Point[1].y:=-50.0;
  106.   Point[1].z:=-50.0;
  107.   Point[2].x:=-50.0;
  108.   Point[2].y:=50.0;
  109.   Point[2].z:=-50.0;
  110.   Point[3].x:=50.0;
  111.   Point[3].y:=50.0;
  112.   Point[3].z:=-50.0;
  113.   Point[4].x:=50.0;
  114.   Point[4].y:=-50.0;
  115.   Point[4].z:=-50.0;
  116.   FOR n:=5 TO 8 DO
  117.     Point[n]:=Point[n-4];
  118.     Point[n].z:=50.0;
  119.   END;
  120.   (*        / 1   0    0 \
  121.      RotX:=     | 0  cos  sin|
  122.              \ 0  -sin cos/    *)
  123.   RotX[1,1]:=1.0;
  124.   RotX[1,2]:=0.0;
  125.   RotX[1,3]:=0.0;
  126.   RotX[2,1]:=0.0;
  127.   RotX[2,2]:=Cos(alpha);
  128.   RotX[2,3]:=-Sin(alpha);
  129.   RotX[3,1]:=0.0;
  130.   RotX[3,2]:=Sin(alpha);
  131.   RotX[3,3]:=Cos(alpha);
  132.   (*        /cos  sin 0\
  133.      RotZ:=     |-sin cos 0|
  134.              \ 0   0   1/    *)
  135.   RotZ[1,1]:=Cos(beta)*grow;
  136.   RotZ[1,2]:=Sin(beta)*grow;
  137.   RotZ[1,3]:=0.0;
  138.   RotZ[2,1]:=-Sin(beta)*grow;
  139.   RotZ[2,2]:=Cos(beta)*grow;
  140.   RotZ[2,3]:=0.0;
  141.   RotZ[3,1]:=0.0;
  142.   RotZ[3,2]:=0.0;
  143.   RotZ[3,3]:=1.0;
  144.   (*        /cos  0 -sin\
  145.      RotY:=     | 0   1   0 |
  146.              \sin  0  cos/    *)
  147.   RotY[1,1]:=Cos(gamma);
  148.   RotY[1,2]:=0.0;
  149.   RotY[1,3]:=-Sin(gamma);
  150.   RotY[2,1]:=0.0;
  151.   RotY[2,2]:=1.0;
  152.   RotY[2,3]:=0.0;
  153.   RotY[3,1]:=Sin(gamma);
  154.   RotY[3,2]:=0.0;
  155.   RotY[3,3]:=Cos(gamma);
  156.   Mmul3(RotY,RotZ,Matrix);
  157.   Mmul3(Matrix,RotX,Matrix);
  158.   DrawCube;
  159.   FOR n:=1 TO 200 DO
  160.     FOR m:=1 TO 8 DO
  161.       Trans3(Matrix,Point[m],Point[m]);
  162.     END;
  163.     DeleteCube;
  164.     DrawCube;
  165.     WaitTOF;
  166.   END;
  167.   IF Invert3(Matrix) THEN END;
  168.   Mmul3(Matrix,Matrix,Matrix);
  169.   FOR n:=1 TO 100 DO
  170.     FOR m:=1 TO 8 DO
  171.       Trans3(Matrix,Point[m],Point[m]);
  172.     END;
  173.     DeleteCube;
  174.     DrawCube;
  175.     WaitTOF;
  176.   END;
  177.   WaitPort(Window^.userPort);
  178.   CloseWindow(Window);
  179.   CloseScreen(Screen);
  180. END R3Test.
  181.